home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
aie8911.zip
/
FILEMOD.ARI
< prev
next >
Wrap
Text File
|
1989-08-27
|
16KB
|
583 lines
%%%%%%%%%% end prepcomp generated declarations %%%%%%%%%%%%%%%%%%%%
% :- module filemod.
:- visible testfn / 1 .
:- extrn
already_at_eof / 1 : interp.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%% tracing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
file_trace(X) :- trace_message( file_trace, X ).
filenames_trace(X) :- trace_message( filenames_trace , X).
/*
#########################################################################
reconsult_if_there -- with no message to user
#########################################################################
Purpose:
reconsults a file if it is there
Call:
reconsult_if_there(Filename)
Input args:
Filename = name of file to reconsult
Output args:
none
Success conditions:
always succeeds
Effect:
If the file Filename exists, it is reconsulted. If Filename does not
exist, reconsult_if_there has no effect.
*/
reconsult_if_there(Filename) :-
file_exists(Filename),
reconsult(Filename),!.
reconsult_if_there(_).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%% open_if_possible %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
open_if_possible( KB_file,
_,
Inhandle) :-
file_exists( KB_file),
open(Inhandle, KB_file , r), !.
open_if_possible( KB_file,
Msg,
_) :-
log_write(KB_file),
log_write( Msg),
log_nl,
fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%% process_file_lines %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
Purpose: to apply a Prolog goal to every line in the file,
checking for whether the file is there, and
doing all file housekeeping.
Input parms:
LineVar = a variable that gets successively set to each
line in the file
Inhandle = handle of input file
Outhandle = handle of output file
Term = a Prolog goal containing the Var's. Term is tried with
LineVar set to each line in the file in succession
and HandleVar set to the output file handle
Success conditions:
succeeds when the goal is successfully applied to the file.
Notes:
applies Term to each line in Filename.
LineVar is the variable in Term which each line in turn gets
substituted for.
Keeps going even if Term fails on some lines until end of file.
Succeeds iff file is successfully processed.
*/
:- mode process_file_lines( +, +, +, +).
process_file_lines( LineVar,
Inhandle,
Outhandle,
Term ) :-
file_trace([$e process_file_lines$]),
process_file_lines_hlpr( LineVar, Inhandle, Outhandle, Term ),
!,
( valid_handle( Outhandle),
write( Outhandle,
$%%%%%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$),
nl( Outhandle),
log_write(
$%%%%%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$),
log_nl ,
close( Outhandle)
; true),
close(Inhandle).
process_file_lines( _ , Filename, _ ) :-
trace_message([$unable to process $,Filename]),fail.
valid_handle( Outhandle) :-
integer( Outhandle),
Outhandle > 0.
%%%%%%%%%%%%%%% process_file_lines_hlpr %%%%%%%%
:- mode process_file_lines_hlpr( +, +, +, +).
process_file_lines_hlpr( Var, Inhandle, Outhandle, Term ) :-
repeat,
file_trace([$b process_file_line $ ]),
process_file_line(Var, Inhandle, Outhandle, Term ) .
%%%%%%%%%%%%%%% process_file_line %%%%%%%%
:- mode process_file_line( +, +, +, +).
process_file_line( Var, Inhandle, Outhandle , Term ) :-
% log_write($ process file line trace rule$), nl,
file_trace([$e process_file_line trace rule$ ,
Var, $ $,
Inhandle, $ $,
Outhandle, $ $,
Term
]),
fail.
process_file_line( Var, Inhandle, Outhandle , Term ) :-
file_trace([$e process_file_line eof rule $ ]),
retract(already_at_eof(Inhandle)),!,
file_trace([$x process_file_line r 1$ ]).
process_file_line(Var, Inhandle, Outhandle, Term ) :-
file_trace([$e process_file_line main rule $ ]),
gc,
get_next_line(Inhandle,Line),!,
file_trace([$i process_file_line Line = $, Line ]),
% log_write($at $), log_write(Line),nl,
process_file_line1(Var, Inhandle, Line, Outhandle, Term ),
!,
fail.
process_file_line( _ , _ , _ , _ ) :-
file_trace([$x process_file_line $ ]).
%%%%%%%%%%%%%%% unread_line_to_handle %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
CALL:
unread_line_to_handle(Inhandle,Line)
INPUTS:
Inhandle = the handle to read from
OUTPUTS:
Line = the line read.
PURPOSE:
Unreads a line from a file.
*/
:- mode unread_line_to_handle( +, -).
unread_line_to_handle( Inhandle, Line) :-
asserta( zzz_read_from_handle( Inhandle, Line)),
!.
%%%%%%%%%%%%%%% process_file_line1 %%%%%%%%
:- mode process_file_line1( +, +, +, +, +).
process_file_line1( _ , Inhandle , Line , _ , _ ) :-
file_trace([$e process_file_line1 eof rule $ ]),
is_eof(Line),!,
asserta(already_at_eof(Inhandle)).
process_file_line1( Var, _, Line, Outhandle, Term ) :-
file_trace([$e process_file_line1 main rule $ ]),
Var = Line,
once( call( Term) ), ! .
list_of_lines(In_handle, List) :-
list_of_lines_hlpr(In_handle, [], List) .
list_of_lines_hlpr( In_handle, Sofar, List) :-
get_next_line( In_handle, Line), !,
( blank_line( Line),
!,
reverse( Sofar, List)
; list_of_lines_hlpr( In_handle, [Line | Sofar] , List) ).
list_of_lines_hlpr( In_handle, Sofar, Sofar).
%%%%%%%%%%%%%%% get_next_line %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
CALL:
get_next_line(Inhandle,Line)
INPUTS:
Inhandle = the handle to read from
OUTPUTS:
Line = the line read.
SUCCESS CONDITIONS:
There is an unused line from the input handle to be processed.
*/
:- mode get_next_line( +, -).
get_next_line( Inhandle, Line) :-
call(already_at_eof(Inhandle)),
!,
Line = $ $.
get_next_line( Inhandle, Line) :-
retract( zzz_read_from_handle( Inhandle, Line)),
!.
get_next_line( Inhandle, Line) :-
gc,
read_line(Inhandle,Line0),!,
log_write($at $), log_write(Line0),log_nl,
( is_eof(Line0),!,
asserta(already_at_eof(Inhandle)),
Line = $ $
; Line = Line0).
/*
#########################################################################
is_eof : succeeds at end of file
#########################################################################
*/
% This first rule is just to trace with -- comment it out if U do not
% want to trace this pred.
% is_eof(X):- file_trace([$ e is_eof, Arg = $,X]),
% fail.
is_eof( Line) :-
string_length( Line, Lnth),
Last_pos is Lnth - 1,
nth_char( Last_pos, Line, 26), % is ascii 26 last char
!.
is_eof(end_of_file) :-
!.
/*
#########################################################################
create_new_file_for_appending
#########################################################################
create_new_file_for_appending(Outhandle,Output_file)
Opens an output file for appending stuff into the file.
Arument Mode Function
------- ---- --------
Outhandle out output file handle, file open for append
Output_file in name of file to be opened for append
*/
create_new_file_for_appending(Outhandle,Output_file):-
create(H1,Output_file),
close(H1),
open(Outhandle,Output_file,a).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%% get file names %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
get_file_names(InName, _ , OutName, _ ) :-
file_trace([$e get_compare_file_names$]),
command_string(Cmd_line),
filenames(Cmd_line, [InName, OutName | _]),
file_trace([$x get_compare_file_names$]),!.
get_file_names(InName, InPrompt, OutName, OutPrompt) :-
get_file_name( InPrompt, InName ),
get_file_name( OutPrompt, OutName ).
get_file_name(Prompt, Filename) :-
log_write(Prompt),
read_line(0, String),
filenames(String,[Filename|_]).
%%%%%%%%%%%%%%%%%%%% file_id preds %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
file_id( String, [device : D,
path : P,
name : N,
ext : E ] )
finds the parts of a file description that occur first in a string.
file_id_rule /3 does the same to as a grammar rule to a list of chars.
filename( String, Filename) finds a file name located initially in a string,
ingoring any init. spaces.
filename_rule does the same thing to a list of chars as a grammar rule
filenames(String, List_of_file_names) returns a list of file names in a
string.
filenames_rule does the same thing to a list of chars as a grammar rule.
DEFAULTS
All these predicates return as defaults the current directory and path.
FILES TO RECONSULT IN ADDITION TO THIS ONE:
:- reconsult(next_tok).
:- reconsult($\lib\strings\IS_CHAR$).
EXAMPLES
testpred :- % for file_id
chdir(C),
log_write($current directory = $),
log_write(C), log_nl,
file_id(C, Frame),
log_write(Frame),log_nl.
testpred :- % FOR filenames
log_write($list of files : $),
read_line(0,Response),
filenames(Response, Files),
log_write($Files = $),log_write(Files),log_nl.
testpred :- % FOR filenames
log_write($list of files : $),
read_line(0,Response),
filenames(Response, File ),
log_write($File = $),log_write(File ),log_nl.
:- public file_id /2: far ,
file_id_rule /3: far ,
filename /2: far ,
filenames_rule /3: far ,
filenames/2: far .
:- visible file_id /2 ,
file_id_rule /3 ,
filename /2 ,
filenames_rule /3 ,
filenames/2 .
*/
% :- extrn
% tokens / 3,
% trace_message / 2 :far.
filenames(String, List_of_file_names) :-
list_text(List, String), !,
tokens( Tokens, List, []), !,
filenames_rule( List_of_file_names,
Tokens,
_).
filenames_rule( Filenames ) --> filename_separator(_),!,
filenames_rule( Filenames ).
filenames_rule([Filename | Filenames]) -->
filename_rule( Filename ),!,
filenames_rule( Filenames ).
filenames_rule( []) --> !.
filename_separator($,$) --> [char($,$)],!.
filename( String, Filename) :-
file_id( String, Frame),
filenames_trace([$i filename, Frame = $, Frame]),
Frame = [device : D,
path : P,
name : N,
ext : E ] ,
concat([D,$:$,P,$\$,N,$.$,E], Filename).
file_id( String, [device : D,
path : P,
name : N,
ext : E ] ) :-
% get part of string before a space
list_text(List, String), !,
tokens( Tokens, List, []), !,
file_id_rule( [device : D,
path : P,
name : N,
ext : E ] ,
Tokens,
_).
filename_rule( Filename ) -->
file_id_rule( Frame),
{ filenames_trace([$i filename_rule Frame = $, Frame]),
Frame = [device : D,
path : P,
name : N,
ext : E ] ,
concat([D,$:$,P,$\$,N,$.$,E], Filename)}.
file_id_rule( [device : D,
path : P,
name : N,
ext : E ] ) --> device(D),!,
path_and_file([path : P,
name : N,
ext : E]).
file_id_rule( [device : D,
path : P,
name : N,
ext : E ] ) --> path_and_file([path : P,
name : N,
ext : E]),
{disk(D)},!.
device(D) --> [alphanum(D),char($:$)],!.
path_and_file([path : P,
name : N,
ext : E]) --> path(P) , !,
name_and_ext([name : N,
ext : E] ).
path_and_file([path : P,
name : N,
ext : E]) --> name_and_ext([name : N,
ext : E] ),!,
{chdir(X),
filenames_trace([$Chdir = $,X]),
path_and_file_hlpr(X, P)}.
path_and_file_hlpr(Device_and_path, Path) :-
filenames_trace([$e path_and_file_hlpr$]),
concat( Device_and_path, $\a.b$, String),
file_id( String,
[device : _,
path : Path,
name : _,
ext : _ ] ),
filenames_trace([$x path_and_file_hlpr Path = $, Path ]).
% find explicit paths
path(P) --> init_segment_of_path(I),!,
path_tail(T),
{concat(I,T,P)}.
path(P) --> path_segment(S), !,
path_tail(T),
{concat(S,T,P)}.
init_segment_of_path($\$ ) --> [char($\$)] ,!.
init_segment_of_path($..\$) --> [char($.$), char($.$), char($\$) ] ,!.
path_tail(T) --> path_segment(S), !,
path_tail(T2),
{T2 == $$, !, T=S;
concat([S, $\$,T2], T)}.
path_tail($$) --> !.
path_segment(S) --> subdir_name(S),[char($\$)],!.
subdir_name(N) --> n_and_e(N1,E), !,
{concat([N1,$.$,E],N)}.
subdir_name(N) --> [alphanum(N) ],!.
n_and_e(N ,E) --> [alphanum(N),char($.$),alphanum(E)] ,!.
name_and_ext([name : N,
ext : E] ) --> n_and_e(N ,E),!.
name_and_ext([name : N,
ext : E] ) --> [ alphanum(N) ],!,
{ E = $$}.
%%%%%%%%%%%%%%%% end file_id %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
#########################################################################
File Exits
#########################################################################
*/
file_exists(Filename):-
directory(Filename,_,_,_,_,_). /* look for Filename on disk */
/* succeed if there */
%%%%%%%%%%%%%%% test %%%%%%%%%%%%%%%%%%%%%%
/* Here is a test for process_file_lines.
To run it you should have an ASCII text
file named foo in your current directory.
(Uncomment out the test to run it.)
*/
testfn(X) :- log_write(X), log_nl.
% eof %%%